home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0126_More STAR-ROUTINE.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  2.2 KB  |  67 lines
  1. {
  2. Howdy all!
  3.  
  4. By request here's the stars-routine, the final update. ;-)
  5. Limits: cpu-speed and conv.-memory. No others...
  6.  
  7. }
  8. program _stars;
  9. { Done by Sven van Heel and Bas van Gaalen, Holland, PD }
  10. uses crt;
  11. const
  12.   f=6; nofstars=100; vidseg:word=$a000;
  13.   bitmask:array[0..1,0..4,0..4] of byte=(
  14.     ((0,0,1,0,0),(0,0,3,0,0),(1,3,6,3,1),(0,0,3,0,0),(0,0,1,0,0)),
  15.     ((0,0,6,0,0),(0,0,3,0,0),(6,3,1,3,6),(0,0,3,0,0),(0,0,6,0,0)));
  16. type starstruc=record
  17.   xp,yp:word; phase,col:byte; dur:shortint; active:boolean; end;
  18. var stars:array[1..nofstars] of starstruc;
  19.  
  20. procedure setpal(col,r,g,b : byte); assembler; asm
  21.   mov dx,03c8h; mov al,col; out dx,al; inc dx; mov al,r
  22.   out dx,al; mov al,g; out dx,al; mov al,b; out dx,al; end;
  23.  
  24. procedure retrace; assembler; asm
  25.   mov dx,3dah; @vert1: in al,dx; test al,8; jz @vert1
  26.   @vert2: in al,dx; test al,8; jnz @vert2; end;
  27.  
  28. var i,x,y:word;
  29. begin
  30.   asm mov ax,13h; int 10h; end;
  31.   for i:=1 to 10 do begin
  32.     setpal(i,f*i,0,0); setpal(21-i,f*i,0,0); setpal(20+i,0,0,0);
  33.     setpal(30+i,0,f*i,0); setpal(51-i,0,f*i,0); setpal(50+i,0,0,0);
  34.     setpal(60+i,0,0,f*i); setpal(81-i,0,0,f*i); setpal(80+i,0,0,0);
  35.     setpal(90+i,f*i,f*i,0); setpal(111-i,f*i,f*i,0); setpal(110+i,0,0,0);
  36.     setpal(120+i,0,f*i,f*i); setpal(141-i,0,f*i,f*i); setpal(140+i,0,0,0);
  37.     setpal(150+i,f*i,f*i,f*i); setpal(171-i,f*i,f*i,f*i); setpal(170+i,0,0,0);
  38.   end;
  39.   randomize;
  40.   for i:=1 to nofstars do with stars[i] do begin
  41.     xp:=0; yp:=0; col:=0; phase:=0;
  42.     dur:=random(20);
  43.     active:=false;
  44.   end;
  45.   repeat
  46.     retrace; retrace;
  47.     {setpal(0,0,0,30);}
  48.     for i:=1 to nofstars do with stars[i] do begin
  49.       dec(dur);
  50.       if (not active) and (dur<0) then begin
  51.         active:=true; phase:=0; col:=30*random(6);
  52.         xp:=random(315); yp:=random(195);
  53.       end;
  54.     end;
  55.     for i:=1 to nofstars do with stars[i] do
  56.       if active then begin
  57.         for x:=0 to 4 do for y:=0 to 4 do
  58.           if bitmask[byte(phase>10),x,y]>0 then
  59.             mem[vidseg:(yp+y)*320+xp+x]:=bitmask[byte(phase>10),x,y]+col+phase;
  60.         inc(phase);
  61.         if phase=20 then begin active:=false; dur:=random(20); end;
  62.       end;
  63.     setpal(0,0,0,0);
  64.   until keypressed;
  65.   textmode(lastmode);
  66. end.
  67.